-- CIS 552, Mini-project
-- by Mike Gottlieb and Reilly Grant

-- |Representation and functions on playing cards.
module Card (T, Rank, Suit(..), -- types
             card, suit, rank, rankName, -- accessors
             valid, parse, -- functions
             test -- tests
            ) where

import Test.QuickCheck hiding (test)
import Util

data T = Card Suit Rank

type Rank = Integer -- Rank is one of [2..14] 14 being Ace
data Suit = Heart | Club | Diamond | Spade -- Suit is one of these
            deriving (Show, Enum, Eq, Bounded)

instance Eq T where -- compares suit and rank for equality
    (==) (Card s1 r1) (Card s2 r2) = (s1 == s2) && (r1 == r2)

instance Ord T where -- cards only ordered by rank
    compare (Card _ r1) (Card _ r2) = compare r1 r2

instance Show T where -- use shorter representation for printing
    show (Card s r) = rankName r ++ shortSuit s

-- |Exported function to contruct a card.
card :: Suit -> Rank -> T
card = Card

-- |Gets the suit out of a Card.
suit :: T -> Suit 
suit (Card s r) = s

-- |Gets the rank out of a Card.
rank :: T -> Rank 
rank (Card s r) = r

-- |Tests if the rank of a card is valid, suit is by definition valid.
valid :: T -> Bool 
valid (Card s r) = (r > 1) && (r < 15)

-- |String representations of suits.
shortSuit :: Suit -> String 
shortSuit Heart   = "H"
shortSuit Club    = "C"
shortSuit Diamond = "D"
shortSuit Spade   = "S"

-- |String representations of ranks.
rankName :: Rank -> String 
rankName 11 = "J"
rankName 12 = "Q"
rankName 13 = "K"
rankName 14 = "A"
rankName n  = show n

-- |Parse the short representation of a card into the card type.
parse :: String -> Maybe T
parse s = do suit <- parseSuit (last s)
             rank <- parseRank (init s)
             let c = card suit rank
             if valid c then Just c
                        else Nothing

-- |Special cases for Jack, Queen, King, Ace.
parseRank :: String -> Maybe Rank
parseRank "A" = Just 14
parseRank "J" = Just 11
parseRank "Q" = Just 12
parseRank "K" = Just 13
parseRank n = readMaybe n

-- |Parse the short reprentations of suits.
parseSuit :: Char -> Maybe Suit
parseSuit 'H' = Just Heart
parseSuit 'C' = Just Club
parseSuit 'D' = Just Diamond
parseSuit 'S' = Just Spade
parseSuit s = Nothing

-- Used to generate randoms suits for tests.
instance Arbitrary Suit where
    arbitrary = oneof $ map return [Heart, Club, Diamond, Spade]
    coarbitrary s = case s of
                      Heart -> variant 0
                      Club -> variant 1
                      Diamond -> variant 2
                      Spade -> variant 3

prop_legalCard s r =
    ((r > 1) && (r < 15)) == (valid (card s r))
    -- The type system won't let s be anything other than one of the type
    -- constructors for Suit, and therefore a valid value.

invalidCard :: T
invalidCard = card Heart (-1)

-- |Test constructing a card from parsing a its representation.
prop_parseCard s r =
    valid c ==> maybe invalidCard id (parse (show c)) == c
    where c = card s r

-- |Run all card test cases.
test = do quickCheck prop_legalCard
          quickCheck prop_parseCard
